home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-03
/
pdoxde.zip
/
PXENGWIN.BAS
< prev
next >
Wrap
BASIC Source File
|
1991-08-09
|
16KB
|
402 lines
'******* Declarations for Using the Paradox 3.5 Engine ******
'initialize engine connection
Declare Function PXWinInit Lib "Pxengwin.dll" (ByVal Application$, ByVal Mode%) As Integer
'exit and deallocate
Declare Function PXExit Lib "Pxengwin.dll" () As Integer
'open table for access; return table handle
Declare Function PXTblOpen Lib "Pxengwin.dll" (ByVal TblName$, TblHnd%, ByVal index%, ByVal change%) As Integer
'close access to table
Declare Function PXTblClose Lib "Pxengwin.dll" (ByVal TblHnd%) As Integer
'create empty table
Declare Function PXTblCreate Lib "Pxengwin.dll" (ByVal TblName$, ByVal nFields%, FldNames As Any, FldTypes As Any) As Integer
'delete table and its family
Declare Function PXTblDelete Lib "Pxengwin.dll" (ByVal TblName$) As Integer
'append record to end of database
Declare Function PXRecAppend Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal RecHnd%) As Integer
'insert record into database
Declare Function PXRecInsert Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal RecHnd%) As Integer
'update current record
Declare Function PXRecUpdate Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal RecHnd%) As Integer
'delete current record
Declare Function PXRecDelete Lib "Pxengwin.dll" (ByVal TblHnd%) As Integer
'create record buffer for table
Declare Function PXRecBufOpen Lib "Pxengwin.dll" (ByVal TblHnd%, RecHnd%) As Integer
'delete record buffer for table
Declare Function PXRecBufClose Lib "Pxengwin.dll" (ByVal RecHnd%) As Integer
'clear record buffer to spaces
Declare Function PXRecBufEmpty Lib "Pxengwin.dll" (ByVal RecHnd%) As Integer
'copy from one rec buffer to another
Declare Function PXRecBufCopy Lib "Pxengwin.dll" (ByVal FromRecHnd%, ByVal ToRecHnd%) As Integer
'get current record into buffer
Declare Function PXRecGet Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal RecHnd%) As Integer
'put short value
Declare Function PXPutShort Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, ByVal sValue%) As Integer
'put double value
Declare Function PXPutDoub Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, ByVal dValue) As Integer
'put long value
Declare Function PXPutLong Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, ByVal lValue&) As Integer
'put alpha value
Declare Function PXPutAlpha Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, ByVal aValue$) As Integer
'put blank value
Declare Function PXPutBlank Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%) As Integer
'put date value
Declare Function PXPutDate Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, ByVal inDate As Any) As Integer
'get short value
Declare Function PXGetShort Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, sValue%) As Integer
'get double value
Declare Function PXGetDoub Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, dValue#) As Integer
'get long value
Declare Function PXGetLong Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, lValue&) As Integer
'get alpha value
Declare Function PXGetAlpha Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, ByVal bufSize%, ByVal aValue$) As Integer
'is field blank?
Declare Function PXFldBlank Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, ByVal Blank%) As Integer
'get date value
Declare Function PXGetDate Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, outDate As Any) As Integer
'goto specified record number
Declare Function PXRecGoto Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal RecNum%) As Integer
'goto first record
Declare Function PXRecFirst Lib "Pxengwin.dll" (ByVal TblHnd%) As Integer
'goto last record
Declare Function PXRecLast Lib "Pxengwin.dll" (ByVal TblHnd%) As Integer
'goto next record
Declare Function PXRecNext Lib "Pxengwin.dll" (ByVal TblHnd%) As Integer
'goto previous record
Declare Function PXRecPrev Lib "Pxengwin.dll" (ByVal TblHnd%) As Integer
'add index to table
Declare Function PXKeyAdd Lib "Pxengwin.dll" (ByVal TblName$, ByVal nFlds%, ByVal FldHand As Any, ByVal Mode%) As Integer
'drop index from table
Declare Function PXKeyDrop Lib "Pxengwin.dll" (ByVal TblName$, ByVal index%) As Integer
'search for a given key
Declare Function PXSrchKey Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal RecHnd%, ByVal nFlds%, ByVal Mode%) As Integer
'search for a given field
Declare Function PXSrchFld Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal RecHnd%, ByVal FldNum%, ByVal Mode%) As Integer
'check if table exists
Declare Function PXTblExist Lib "Pxengwin.dll" (ByVal TblName$, ByVal exist%) As Integer
'return current record number
Declare Function PXRecNum Lib "Pxengwin.dll" (ByVal TblHnd%, RecNum%) As Integer
'return number of recs in table
Declare Function PXTblNRecs Lib "Pxengwin.dll" (ByVal TblHnd%, nRecs%) As Integer
'return number of fields in record
Declare Function PXRecNFlds Lib "Pxengwin.dll" (ByVal TblHnd%, nFlds%) As Integer
'return field number of given field name in table
Declare Function PXFldHandle Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal FldName$, FldHnd%) As Integer
'return field type of given field in table
Declare Function pxFldType Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal FldHnd%, ByVal BufSiz%, ByVal fldtype$) As Integer
'return field name of given field in table
Declare Function PXFldName Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal FldHnd%, ByVal BufSiz%, ByVal FldName$) As Integer
'return error text associated with error number
Declare Function PXErrMsg Lib "Pxengwin.dll" (ByVal rc%) As String
'decode a date field from table
Declare Function PXDateDecode Lib "Pxengwin.dll" (ByVal outDate&, mm%, dd%, yy%) As Integer
'encode a date to field
Declare Function PXDateEncode Lib "Pxengwin.dll" (ByVal mm%, ByVal dd%, ByVal yy%, pDate&) As Integer
Sub PXError ()
Dim msgbuf As String
If rc = 0 Then
Exit Sub
End If
' msgbuff = Code + "=" + Str$(rc)
' msgbuff = PXErrMsg(rc)
Select Case rc
Case Is = PXERR_NOTINITERR
msgbuf = " Engine not initialized"
Case Is = PXERR_ALREADYINIT
msgbuf = "Engine already initialized"
Case Is = PXERR_NOTLOGGEDIN
msgbuf = " Could not log onto network"
Case Is = PXERR_NONETINIT
msgbuf = " Engine not initialized"
Case Is = PXERR_NETMULTIPLE
msgbuf = " multiple PARADOX.NET files"
Case Is = PXERR_CANTSHAREPDOXNET
msgbuf = " can't lock PARADOX.NET-is SHARE.EXE loaded?"
Case Is = PXERR_WINDOWSREALMODE
msgbuf = " can't run Engine in Windows real mode"
Case Is = PXERR_DRIVENOTREADY
msgbuf = " Drive not ready"
Case Is = PXERR_DISKWRITEPRO
msgbuf = " Disk is write protected"
Case Is = PXERR_GENERALFAILURE
msgbuf = " General hardware error"
Case Is = PXERR_DIRNOTFOUND
msgbuf = " Directory not found"
Case Is = PXERR_DIRBUSY
msgbuf = " Sharing violation-directory busy"
Case Is = PXERR_DIRLOCKED
msgbuf = " Sharing violation-directory locked"
Case Is = PXERR_DIRNOACCESS
msgbuf = " No access to directory"
Case Is = PXERR_DIRNOTPRIVATE
msgbuf = " Single user, but directory is shared"
Case Is = PXERR_FILEBUSY
msgbuf = " File is busy"
Case Is = PXERR_FILELOCKED
msgbuf = " File is locked"
Case Is = PXERR_FILENOTFOUND
msgbuf = " Could not find file"
Case Is = PXERR_TABLEBUSY
msgbuf = " Table is busy"
Case Is = PXERR_TABLELOCKED
msgbuf = " Table is locked"
Case Is = PXERR_TABLENOTFOUND
msgbuf = " Table was not found"
Case Is = PXERR_TABLEOPEN
msgbuf = " Unable to perform operation on open table"
Case Is = PXERR_TABLEINDEXED
msgbuf = " Table is indexed"
Case Is = PXERR_TABLENOTINDEXED
msgbuf = " Table is not indexed"
Case Is = PXERR_TABLEEMPTY
msgbuf = " Operation on empty table"
Case Is = PXERR_TABLEWRITEPRO
msgbuf = " Table is write protected"
Case Is = PXERR_TABLECORRUPTED
msgbuf = " Table is corrupted"
Case Is = PXERR_TABLEFULL
msgbuf = " Table is full"
Case Is = PXERR_TABLESQL
msgbuf = " Table is SQL replica"
Case Is = PXERR_INSUFRIGHTS
msgbuf = " Insufficient password rights"
Case Is = PXERR_XCORRUPTED
msgbuf = " Primary index is corrupted"
Case Is = PXERR_XOUTOFDATE
msgbuf = " Primary index is out of date"
Case Is = PXERR_XSORTVERSION
msgbuf = " Sort for index different from table"
Case Is = PXERR_SXCORRUPTED
msgbuf = " Secondary index is corrupted"
Case Is = PXERR_SXOUTOFDATE
msgbuf = " Secondary index is out of date"
Case Is = PXERR_SXNOTFOUND
msgbuf = " Secondary index was not found"
Case Is = PXERR_SXOPEN
msgbuf = " Secondary index is already open"
Case Is = PXERR_SXCANTUPDATE
msgbuf = " Can't update table open on non-maintained secondary" 'maintained secondary"
Case Is = PXERR_RECTOOBIG
msgbuf = " Record too big for index"
Case Is = PXERR_RECDELETED
msgbuf = " Another user deleted record"
Case Is = PXERR_RECLOCKED
msgbuf = " Record is locked"
Case Is = PXERR_RECNOTFOUND
msgbuf = " Record was not found"
Case Is = PXERR_KEYVIOL
msgbuf = " Key violation"
Case Is = PXERR_ENDOFTABLE
msgbuf = " End of table"
Case Is = PXERR_STARTOFTABLE
msgbuf = " Start of table"
Case Is = PXERR_TOOMANYCLIENTS
msgbuf = " Too many clients"
Case Is = PXERR_EXCEEDSCONFIGLIMITS
msgbuf = " Exceeds table conflicts"
Case Is = PXERR_CANTREMAPFILEHANDLE
msgbuf = " Cant remap file handle"
Case Is = PXERR_OUTOFMEM
msgbuf = " Not enough memory to complete operation"
Case Is = PXERR_OUTOFDISK
msgbuf = " Not enough disk space to complete operation"
Case Is = PXERR_OUTOFSTACK
msgbuf = " Not enough stack space to complete operation"
Case Is = PXERR_OUTOFSWAPBUF
msgbuf = " Not enough swap buffer space to complete operation"
Case Is = PXERR_OUTOFFILEHANDLES
msgbuf = " No more file handles available"
Case Is = PXERR_OUTOFTABLEHANDLES
msgbuf = " No more table handles" 'available
Case Is = PXERR_OUTOFRECHANDLES
msgbuf = " No more record handles" 'available
Case Is = PXERR_OUTOFLOCKHANDLES
msgbuf = " Too many locks on table"
Case Is = PXERR_NOMORETMPNAMES
msgbuf = " No more temporary names available"
Case Is = PXERR_TOOMANYPASSW
msgbuf = " Too many passwords specified"
Case Is = PXERR_TYPEMISMATCH
msgbuf = " Data type mismatch"
Case Is = PXERR_OUTOFRANGE
msgbuf = " Argument out of range"
Case Is = PXERR_INVPARAMETER
msgbuf = " Invalid argument"
Case Is = PXERR_INVDATE
msgbuf = " Invalid date given"
Case Is = PXERR_INVFIELDHANDLE
msgbuf = " Invalid field handle"
Case Is = PXERR_INVRECHANDLE
msgbuf = " Invalid record handle"
Case Is = PXERR_INVTABLEHANDLE
msgbuf = " Invalid table handle"
Case Is = PXERR_INVLOCKHANDLE
msgbuf = " Invalid lock handle"
Case Is = PXERR_INVDIRNAME
msgbuf = " Invalid directory name"
Case Is = PXERR_INVFILENAME
msgbuf = " Invalid file name"
Case Is = PXERR_INVTABLENAME
msgbuf = " Invalid table name"
Case Is = PXERR_INVFIELDNAME
msgbuf = " Invalid field name"
Case Is = PXERR_INVLOCKCODE
msgbuf = " Invalid lock code"
Case Is = PXERR_INVUNLOCK
msgbuf = " Invalid unlock"
Case Is = PXERR_INVSORTORDER
msgbuf = " Invalid sort order table"
Case Is = PXERR_INVPASSW
msgbuf = " Invalid password"
Case Is = PXERR_INVNETTYPE
msgbuf = " Invalid net type (PXNetInit)"
Case Is = PXERR_BUFTOOSMALL
msgbuf = " Buffer too small for result"
Case Is = PXERR_STRUCTDIFFER
msgbuf = " Table structures are different"
Case Is = PXERR_INVENGINESTATE
msgbuf = " Previous fatal error"
End Select
response% = MsgBox(msgbuf, 17, "Paradox Error")
If response% <> MBOK Then
rc = PXExit()
End
End If
End Sub
Sub PXInit (AppName$, Mode%)
'mode can be any of: PXSINGLECLIENT,PXEXCLUSIVE,PXSHARED
rc = PXWinInit(AppName$, Mode%)
PXError
End Sub
Sub PXOpen (TblName$, TblHnd%, RecHnd%)
rc = PXTblOpen(TblName$, TblHnd%, tIndex, TRUE)
PXError
rc = PXRecBufOpen(TblHnd%, RecHnd%)
PXError
rc = PXRecBufEmpty(RecHnd%)
PXError
End Sub
Sub GetField (RecHnd%, FldHnd%, fldtype$)
returnFld = String$(255, 0)
aValue = ""
lValue = 0
dValue = 0
Select Case Mid$(fldtype$, 1, 1)
Case Is = "A"
rc = PXGetAlpha(RecHnd%, FldHnd%, 255, aValue)
PXError
returnFld = aValue
Case Is = "N"
rc = PXGetLong(RecHnd%, FldHnd%, lValue)
PXError
If lValue < 0 Then
lValue = 0
End If
returnFld = Format$(lValue, "###0")
Case Is = "$"
rc = PXGetDoub(RecHnd%, FldHnd%, dValue)
PXError
If dValue < 0 Then
dValue = 0
End If
returnFld = Format$(dValue, "###,##0.00")
Case Is = "D"
rc = PXGetDate(RecHnd%, FldHnd%, lValue)
PXError
rc = PXDateDecode(lValue, mm, dd, yy)
returnFld = Format$(lValue, "##/##/##")
End Select
End Sub
Sub PXNext (TblHnd%, RecHnd%)
rc = PXRecNext(TblHnd%)
If rc = PXERR_ENDOFTABLE Then
Exit Sub
End If
rc = PXRecGet(TblHnd%, RecHnd%)
End Sub
Sub PXPrev (TblHnd%, RecHnd%)
rc = PXRecPrev(TblHnd)
If rc = PXERR_STARTOFTABLE Then
Exit Sub
End If
rc = PXRecGet(TblHnd%, RecHnd%)
End Sub
Sub PutField (RecHnd%, FldHnd%, fldtype$)
Select Case Mid$(fldtype$, 1, 1)
Case Is = "A"
rc = PXPutAlpha(RecHnd%, FldHnd%, aValue)
PXError
Case Is = "N"
rc = PXPutBlank(RecHnd%, FldHnd%)
PXError
rc = PXPutLong(RecHnd%, FldHnd%, lValue)
PXError
Case Is = "$"
rc = PXPutBlank(RecHnd%, FldHnd%)
PXError
rc = PXPutLong(RecHnd%, FldHnd%, lValue)
' rc = PXPutDoub(RecHnd%, FldHnd%, dValue)
PXError
Case Is = "D"
rc = PXPutDate(RecHnd%, FldHnd%, lValue)
PXError
End Select
End Sub